home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / List_Class2097321142008.psc / List Class / clsList.cls next >
Text File  |  2008-01-14  |  6KB  |  219 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsList"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Dim blmListEmpty As Boolean
  17.  
  18. Dim strList() As String
  19. Dim lngItemData() As Long
  20.  
  21. Dim lngNewIndex As Long
  22.  
  23. Dim blmSorted As Boolean
  24. Dim strTag As String
  25.  
  26. Public Sub AddItem(ByVal strItem As String, Optional ByVal lngIndex As Long = -1)
  27.     Dim i As Integer
  28.     
  29.     If blmListEmpty Then
  30.         lngNewIndex = 0
  31.     Else
  32.         If lngIndex = -1 Then
  33.             lngNewIndex = UBound(strList) + 1
  34.         Else
  35.             If lngIndex < -1 And lngIndex > UBound(strList) Then Exit Sub
  36.             lngNewIndex = lngIndex
  37.         End If
  38.     End If
  39.     
  40.     If blmListEmpty Then
  41.         ReDim Preserve strList(0) As String
  42.         ReDim Preserve lngItemData(0) As Long
  43.         blmListEmpty = False
  44.     Else
  45.         ReDim Preserve strList(UBound(strList) + 1) As String
  46.         ReDim Preserve lngItemData(UBound(strList) + 1) As Long
  47.     End If
  48.     
  49.     If lngNewIndex < UBound(strList) Then
  50.         For i = UBound(strList) To lngNewIndex + 1 Step -1
  51.            strList(i) = strList(i - 1)
  52.            lngItemData(i) = lngItemData(i - 1)
  53.         Next i
  54.     End If
  55.     
  56.     strList(lngNewIndex) = strItem
  57.     lngItemData(lngNewIndex) = 0
  58.     
  59.     If blmSorted Then Call SortList(0, UBound(strList))
  60.     
  61. End Sub
  62.  
  63. Public Sub Clear()
  64.     
  65.     If blmListEmpty Then Exit Sub
  66.     
  67.     blmListEmpty = True
  68.     
  69.     lngNewIndex = -1
  70.     ReDim strList(0) As String
  71.     ReDim lngItemData(0) As Long
  72.     
  73. End Sub
  74.  
  75. Public Property Let ItemData(ByVal lngIndex As Long, ByVal lngNewValue As Long)
  76.     
  77.     If lngIndex < 0 Or lngIndex > UBound(strList) Then Exit Property
  78.     
  79.     lngItemData(lngIndex) = lngNewValue
  80.     
  81. End Property
  82.  
  83. Public Property Get ItemData(ByVal lngIndex As Long) As Long
  84.     
  85.     If lngIndex < 0 Or lngIndex > UBound(strList) Then Exit Property
  86.     
  87.     ItemData = lngItemData(lngIndex)
  88.     
  89. End Property
  90.  
  91. Public Property Let List(ByVal lngIndex As Long, ByVal strNewValue As String)
  92.     
  93.     If lngIndex < 0 Or lngIndex > UBound(strList) Then Exit Property
  94.     
  95.     strList(lngIndex) = strNewValue
  96.     
  97.     If blmSorted Then Call SortList(0, UBound(strList))
  98.     
  99. End Property
  100.  
  101. Public Property Get List(ByVal lngIndex As Long) As String
  102.     
  103.     If lngIndex < 0 Or lngIndex > UBound(strList) Then Exit Property
  104.     
  105.     List = strList(lngIndex)
  106.     
  107. End Property
  108.  
  109. Public Property Get ListCount() As Long
  110.     
  111.     If lngNewIndex = -1 Then Exit Property
  112.     
  113.     ListCount = UBound(strList) + 1
  114.     
  115. End Property
  116.  
  117. Public Property Get NewIndex() As Long
  118.  
  119.     NewIndex = lngNewIndex
  120.     
  121. End Property
  122.  
  123. Public Sub RemoveItem(ByVal lngIndex As Long)
  124.     Dim i As Integer
  125.     
  126.     If blmListEmpty Or lngIndex < 0 Or lngIndex > UBound(strList) Then Exit Sub
  127.     
  128.     For i = lngIndex To UBound(strList) - 1
  129.         strList(i) = strList(i + 1)
  130.         lngItemData(i) = lngItemData(i + 1)
  131.     Next i
  132.     
  133.     If UBound(strList) = 0 Then
  134.         Call Clear
  135.     Else
  136.         ReDim Preserve strList(UBound(strList) - 1) As String
  137.         ReDim Preserve lngItemData(UBound(lngItemData) - 1) As Long
  138.     End If
  139.     
  140. End Sub
  141.  
  142. Public Property Let Sorted(ByVal blmNewValue As Boolean)
  143.     
  144.     blmSorted = blmNewValue
  145.     
  146.     If blmSorted Then Call SortList(0, UBound(strList))
  147.     
  148. End Property
  149.  
  150. Public Property Get Sorted() As Boolean
  151.     
  152.     Sorted = blmSorted
  153.     
  154. End Property
  155.  
  156. Public Property Let Tag(ByVal strNewValue As String)
  157.     
  158.     strTag = strNewValue
  159.     
  160. End Property
  161.  
  162. Public Property Get Tag() As String
  163.     
  164.     Tag = strTag
  165.     
  166. End Property
  167.  
  168. Private Sub SortList(ByVal lngLowerBound As Long, ByVal lngUpperBound As Long, Optional ByVal lngCount As Long = 0)
  169.     Dim lngBegin As Long, lngEnd As Long, lngTempLong As Long
  170.     Dim strMiddle As String, strTempString As String
  171.     
  172.     If blmListEmpty Then Exit Sub
  173.     
  174.     lngBegin = lngLowerBound
  175.     lngEnd = lngUpperBound
  176.     strMiddle = strList((lngLowerBound + lngUpperBound) / 2)
  177.     If lngCount = 0 Then _
  178.         lngCount = lngUpperBound - lngLowerBound
  179.     
  180.     Do
  181.         While strList(lngBegin) < strMiddle And lngBegin < lngUpperBound
  182.             lngBegin = lngBegin + 1
  183.         Wend
  184.         While strMiddle < strList(lngEnd) And lngEnd > lngLowerBound
  185.             lngEnd = lngEnd - 1
  186.         Wend
  187.         
  188.         If lngBegin <= lngEnd Then
  189.             strTempString = strList(lngBegin)
  190.             strList(lngBegin) = strList(lngEnd)
  191.             strList(lngEnd) = strTempString
  192.             
  193.             lngTempLong = lngItemData(lngBegin)
  194.             lngItemData(lngBegin) = lngItemData(lngEnd)
  195.             lngItemData(lngEnd) = lngTempLong
  196.             
  197.             lngBegin = lngBegin + 1
  198.             lngEnd = lngEnd - 1
  199.         End If
  200.         
  201.     Loop While lngBegin <= lngEnd
  202.     
  203.     If lngLowerBound < lngEnd Then SortList lngLowerBound, lngEnd, lngCount
  204.     If lngBegin < lngUpperBound Then SortList lngBegin, lngUpperBound, lngCount
  205.     
  206. End Sub
  207.  
  208. Private Sub Class_Initialize()
  209.     
  210.     blmListEmpty = True
  211.     
  212. End Sub
  213.  
  214. Private Sub Class_Terminate()
  215.     
  216.     Call Clear
  217.     
  218. End Sub
  219.